Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/C/Frameworks/TransSkel 3.24/Demos/Pascal Demos/Hello/Hello.p

Text File | 1996-01-25 | 4.7 KB | 200 lines | [TEXT/CWIE]

{ TransSkel "hello, world" application in Pascal }

{ Presents a window with "Hello, world." displayed centered in the window }
{ when the window is active, and "Goodbye, world." when the window is }
{ inactive (e.g., when the application is suspended, or when the "About" }
{ alert comes up). }

{ 04 Feb 94 Version 1.00, Paul DuBois }
{
 22 Jun 95
 - Updated for TransSkel 3.22.  The phrase that is initially displayed
 is set according to whether the application is launched into the
 foreground or background.  In order for this to work properly, have to
 install a handler for suspend/resume events to force an activate/deactivate
 of the window (if launched into the background, no activate event happens
 on the first resume, for some reason).
}

program Hello;

    uses
        Types, QuickDrawText, QuickDraw, Windows, Menus, ToolUtils, TransSkel;

    const

{ strings that appear in window }

        hello = 'Hello, world.';
        goodbye = 'Goodbye, world.';

{ resource numbers }

        aboutAlrtRes = 1000;                { About box }
        fileMenuNum = skelAppleMenuID + 1;    { File menu }

{ File menu item numbers }

        quit = 1;

    var

        fileMenu: MenuHandle;

        phrase: Str255;                { current phrase }


{--------------------------------------------------------------------}
{ Menu handling procedures }
{--------------------------------------------------------------------}

{ Handle selection of "About Hello..." item from Apple menu }

    procedure DoAppleMenu (item: Integer);
        var
            ignore: Integer;
    begin
        ignore := SkelAlert(aboutAlrtRes, SkelDlogFilter(nil, true), skelPositionOnParentDevice);
        SkelRmveDlogFilter;
    end;


{ Process selection from File menu }

    procedure DoFileMenu (item: Integer);
    begin
        case item of
            quit:
                SkelStopEventLoop;
        end;
    end;


{ Initialize menus.  Tell TransSkel to process the Apple menu }
{ automatically, and associate the proper procedure with the }
{ File menu. }

    procedure SetupMenus;
        var
            ignore: Boolean;
    begin
        SkelApple('About Hello…', @DoAppleMenu);
        fileMenu := NewMenu(fileMenuNum, 'File');
        AppendMenu(fileMenu, 'Quit/Q');
        ignore := SkelMenu(fileMenu, @DoFileMenu, nil, false, false);

        DrawMenuBar;
    end;


{--------------------------------------------------------------------}
{ Window handling procedures }
{--------------------------------------------------------------------}

{ Draw grow box of window in lower right hand corner }

    procedure DrawGrowBox (w: WindowPtr);
        var
            oldClip: RgnHandle;
            r: Rect;
    begin
        r := w^.portRect;
        r.left := r.right - 15;            { draw only in corner }
        r.top := r.bottom - 15;
        oldClip := NewRgn;
        GetClip(oldClip);
        ClipRect(r);
        DrawGrowIcon(w);
        SetClip(oldClip);
        DisposeRgn(oldClip);
    end;


    procedure Update (resized: Boolean);
        var
            w: WindowPtr;
            r: Rect;
            h, v: Integer;
    begin
        GetPort(w);
        r := w^.portRect;
        EraseRect(r);
        v := (r.top + r.bottom) div 2;
        h := (r.left + r.right - StringWidth(phrase)) div 2;
        MoveTo(h, v);
        DrawString(phrase);
        DrawGrowBox(w);
    end;


{ Normally the grow icon is drawn on a change of activation state, but since }
{ the entire portRect is invalidated here, everything will be redrawn by }
{ Update(), anyway, including the grow box.  So don't bother here. }

    procedure Activate (active: Boolean);
        var
            w: WindowPtr;
    begin
        GetPort(w);
        if (active) then
            phrase := hello
        else
            phrase := goodbye;
        InvalRect(w^.portRect);
    end;


    procedure Clobber;
        var
            w: WindowPtr;
    begin
        GetPort(w);
        DisposeWindow(w);
    end;


procedure DoSuspendResume (inForeground: Boolean);
begin
    SkelActivate (FrontWindow, inForeground);
end;


{ Create window and install handler for it.  Mouse and key clicks are }
{ ignored.  There is no close proc since the window doesn't have a }
{ close box.  There is no idle proc since nothing is done while the }
{ window is in front (all the things that are done are handled by }
{ TransSkel). }

    procedure WindInit;
        var
            w: WindowPtr;
            bounds: Rect;
            ignore: Boolean;
    begin
        if (SkelQuery (skelQInForeground) <> 0) then
            phrase := hello
        else
            phrase := goodbye;

        SetRect(bounds, 0, 0, 200, 100);
        if (SkelQuery(skelQHasColorQD) <> 0) then
            w := NewCWindow(nil, bounds, 'Howdy', false, documentProc + 8, WindowPtr(-1), false, 0)
        else
            w := NewWindow(nil, bounds, 'Howdy', false, documentProc + 8, WindowPtr(-1), false, 0);
        SkelPositionWindow(w, skelPositionOnMainDevice, FixRatio(1, 2), FixRatio(1, 5));
        ignore := SkelWindow(w, nil, nil, @Update, @Activate, nil, @Clobber, nil, false);
        TextFont(0);        { select system font in default size }
        TextSize(0);
        SelectWindow(w);
        ShowWindow(w);
    end;


begin
    SkelInit(nil);
    SetupMenus;
    WindInit;
    SkelSetSuspendResume (@DoSuspendResume);
    SkelEventLoop;
    SkelCleanup;
end.